home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol076 / fromxmod.for < prev    next >
Encoding:
Text File  |  1987-01-14  |  2.8 KB  |  123 lines
  1.  
  2.     program fromxmod
  3. c  convert file of XMODEM 128 byte records with embedded <CR><LF>
  4. c  marking end-of-line and CTRL-Z marking end-of-file
  5. c  to carriage-control=LIST (normal VAX editable file)
  6. c  6/21/83 increased output line buffer to 300 characters.
  7.  
  8.     parameter linelen=500    ! change this if "Out line too long" error
  9.                 ! also the declaration of 'line'
  10.     character*500  line
  11.     character*254 input,output
  12.     character*1 CR,LF,recchar
  13.     integer blank
  14.     logical eof
  15.     data eof/.false./
  16.  
  17.     CR=char(13)
  18.     LF=char(10)
  19.     call lib$get_foreign(line,'$_From  To: ',)
  20.  
  21.     blank=index(line,' ')
  22.     input=line( 1:blank )
  23.     output=line( blank:)
  24.  
  25.     open(6,file=input,status='OLD')
  26. c  set maximum output record length (fortran default is 133)
  27.     open(7,file=output,status='NEW',carriagecontrol='LIST',
  28.     1                        recl=linelen)
  29.  
  30. c  getchar (read new record if no input characters left)
  31. c  if EOF on input, write line and exit
  32. c  if CR then
  33. c    if getchar LF then write line
  34. c    else put back char and putchar CR into line (error if too long)
  35. c    endif
  36. c  else putchar (write error message if line too long)
  37. c  endif
  38. c  loop
  39.  
  40.   100    call getchar(recchar,eof)
  41.     if(eof) goto 200
  42.     if(recchar.eq.CR) then
  43. c    PRINT *,' CR'
  44.         call getchar(recchar,eof)
  45.         if(eof.or.recchar.ne.LF) then
  46.             call putback
  47.             
  48.             len=len+1
  49.             if(len.gt.linelen+1)
  50.     1                print *,' Out line too long.'
  51. c    print*,' too long line=',line
  52.             line(len:len)=recchar
  53.         else
  54. c  was LF
  55. c    PRINT *,' LEN=',LEN
  56. c    print*,' after LF, line=',line(1:len)
  57.             write(7,2000) line(1:len)
  58.             len=0
  59.         endif
  60.     else
  61. c  not CR, was "ordinary" character
  62.         len=len+1
  63.         if(len.gt.linelen+1) then
  64.             print *,' Out line too long.'
  65. c            PRINT *,' LINE=',LINE(1:len)
  66.         endif
  67.         line(len:len)=recchar
  68.     endif
  69.  
  70.     go to 100
  71.  
  72. c  flush last line and exit
  73.   200    continue
  74.     if(len.ne.0) then
  75.         write(7,2000) line(1:len)
  76.  2000        format(a)
  77.     endif
  78.     close(6)
  79.     close(7)
  80.     call exit
  81.  
  82.       end
  83. c------------------------------------------
  84.     subroutine getchar(c,eof)
  85.     character*1 c
  86.     logical eof
  87. c  point to next character in record (read record if necessary)
  88.     character*128 record
  89.     character*1 CTRLZ
  90.     integer point
  91.     logical firsttime
  92.     common /reccom/point,record,firsttime
  93.     data point/0/
  94.     data firsttime/.true./
  95.  
  96.     CTRLZ=char(26)
  97.     point=point+1
  98.     if(point.gt.128.or.firsttime) then
  99.         firsttime=.false.
  100.   100        read(6,1000,end=200) record
  101.  1000        format(a)
  102. c        PRINT *,RECORD
  103.         point=1
  104.     endif
  105. c  strip parity in case CP/M file had it
  106.     c=char(iand(ichar(record(point:point)),127))
  107.     if(c.eq.CTRLZ) eof=.true.
  108.     return
  109.  
  110.   200    eof=.true.
  111.     return
  112.     end
  113. c----------------------------------------------
  114.     subroutine putback
  115. c  point to previous input character so this character will be getchar result
  116. c  even works if 1st char of record
  117.     integer point
  118.     logical eof
  119.     common /reccom/point
  120.  
  121.     point=point-1
  122.     return
  123.     end
  124.